;;;mapping functions and other functionals.  

(DEFPROP MAPPIN (
 ORLIS
 ANDLIS
 MAPCAR
 MAPLIST
 MAPCAR2
 MAPCHOOSE
 MAPAPP
 PICKOUT
 PICKOUTA
 MKMAPCAR
 MKMAPCARV
)MAPPINFNS)

;;;necessary to turnoff reftransparency hack
(SSTATUS PUNT NIL) 

(DEFUN ORLIS (PRED U) 
       (AND (NOT (NULL U)) (OR (PRED (CAR U)) (ORLIS PRED (CDR U))))) 

(DEFUN ANDLIS (PRED U) 
       (OR (NULL U) (AND (PRED (CAR U)) (ANDLIS PRED (CDR U))))) 

(DEFUN MAPCAR (F U) (COND ((NULL U) NIL) (T (CONS (F (CAR U)) (MAPCAR F (CDR U)))) ))
(DEFUN MAPLIST (F U) (COND ((NULL U) NIL) (T (CONS (F U) (MAPLIST F (CDR U)))) ))

(DEFUN MAPCAR2 (FN U V) 
       (COND ((NULL U) NIL)
	     (T (CONS (FN (CAR U) (CAR V))
		      (MAPCAR2 FN (CDR U) (CDR V)))))) 

(DEFUN MAPCHOOSE (PRED FN U) 
       (COND ((NULL U) NIL)
	     ((PRED (CAR U))
	      (CONS (FN (CAR U)) (MAPCHOOSE PRED FN (CDR U))))
	     (T (MAPCHOOSE PRED FN (CDR U))))) 

(DEFUN MAPAPP (FN U) 
       (COND ((NULL U) NIL)
	     (T (APPEND (FN (CAR U)) (MAPAPP FN (CDR U)))))) 

;;;PICKOUT returns a pair of lists the first of which contains those elements of U
;;;that satisfy PRED and second of which contains the rest.

(DEFUN PICKOUT (PRED U) (PICKOUTA PRED U NIL NIL)) 

(DEFUN PICKOUTA (PRED U YES NO) 
       (COND ((NULL U) (CONS YES NO))
	     ((PRED (CAR U))
	      (PICKOUTA PRED (CDR U) (CONS (CAR U) YES) NO))
	     (T (PICKOUTA PRED (CDR U) YES (CONS (CAR U) NO))))) 


;;;MKMAPCAR defines a function FNAM suchthat (FNAM <list>) is the same as
;;;(MAPCAR FEXP <list>)

(DEFUN MKMAPCAR (FNAM FEXP) 
       (PUTPROP FNAM
		(SUBLIS (LIST (CONS 'F FNAM)
			      (CONS 'E FEXP))
			'(LAMBDA (U) (COND ((NULL U) NIL)
					   (T (CONS (E (CAR U))
						    (F (CDR U)))))))
		'EXPR)) 

;;;this version allows you to specify the name of the recursion variable

(DEFUN MKMAPCARV (FNAM FEXP VNAM) 
       (PUTPROP FNAM
		(SUBLIS (LIST (CONS 'F FNAM)
			      (CONS 'E FEXP)
			      (CONS 'U VNAM))
			'(LAMBDA (U) (COND ((NULL U) NIL)
					   (T (CONS (E (CAR U))
						    (F (CDR U)))))))
		'EXPR))